home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Delphi 5 Companion Tools CD / FreeWare / HVDLL / HVDLL.ZIP / ExpImpTestDll.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-04  |  1.9 KB  |  79 lines
  1. unit ExpImpTestDll;
  2. { This unit shows how to import DLL routines by explicitly calling LoadLibrary
  3.   and GetProcAddress. It uses a neat trick of letting routine thunks load the
  4.   DLL and routine address the first time it is called. Further calls go directly
  5.   to the DLL. Note that the same functionality (and more) is acheived in much
  6.   less code by using the HVDLL unit as shown in the DynLinkTest unit. }
  7. interface
  8.  
  9. var
  10.   Routine1 : procedure (A, B, C, D: integer); register;
  11.   Routine2 : procedure (A, B, C, D: integer); pascal;
  12.   Routine3 : procedure (A, B, C, D: integer); cdecl;
  13.   Routine4 : procedure (A, B, C, D: integer); stdcall;
  14.  
  15. implementation
  16.  
  17. uses
  18.   Windows,
  19.   SysUtils,
  20.   Dialogs;
  21.  
  22. var
  23.   TestDllModule: HModule = 0;
  24.  
  25. procedure RaiseLastWin32Error;
  26. begin
  27.   raise Exception.Create('Win32 Error!');
  28. end;
  29.  
  30. function GetTestDllModule: HModule;
  31. begin
  32.   if TestDllModule = 0 then
  33.   begin
  34.     TestDllModule := Windows.LoadLibrary('TestDll.Dll');
  35.     if TestDllModule = 0 then
  36.       RaiseLastWin32Error;
  37.   end;
  38.   Result := TestDllModule;
  39. end;
  40.  
  41. function GetTestDllFunc(const ProcName: string): FarProc;
  42. begin
  43.   Result := Windows.GetProcAddress(GetTestDllModule, PChar(ProcName));
  44.   if Result = nil then
  45.     RaiseLastWin32Error;
  46. end;
  47.  
  48. procedure Routine1_Thunk(A, B, C, D: integer); register;
  49. begin
  50.   Routine1 := GetTestDllFunc('Routine1');
  51.   Routine1(A, B, C, D);
  52. end;
  53.  
  54. procedure Routine2_Thunk(A, B, C, D: integer); pascal;
  55. begin
  56.   Routine2 := GetTestDllFunc('Routine2');
  57.   Routine2(A, B, C, D);
  58. end;
  59.  
  60. procedure Routine3_Thunk(A, B, C, D: integer); cdecl;
  61. begin
  62.   Routine3 := GetTestDllFunc('Routine3');
  63.   Routine3(A, B, C, D);
  64. end;
  65.  
  66. procedure Routine4_Thunk(A, B, C, D: integer); stdcall;
  67. begin
  68.   Routine4 := GetTestDllFunc('Routine4');
  69.   Routine4(A, B, C, D);
  70. end;
  71.  
  72. initialization
  73.   Routine1 := Routine1_Thunk;
  74.   Routine2 := Routine2_Thunk;
  75.   Routine3 := Routine3_Thunk;
  76.   Routine4 := Routine4_Thunk;
  77.  
  78. end.
  79.